home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
LISTSAVE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-10-20
|
4KB
|
149 lines
procedure listfile (n:integer; extended:boolean);
var ud :udrec;
q,xy :sstr;
a :string;
b :string;
c :string;
ed :string;
desc :string;
lamedata :string[1];
up1 :byte;
dah :boolean;
begin
seekudfile (n);
read (udfile,ud);
if asciigraphics in urec.config then
write (^R'│'^S+strr(n)+^R) else write(^R'|'^S+strr(n)+^R);
spacelen(3-length(strr(n)));
if asciigraphics in urec.config then
write (^R'│ ') else write(^R'| ');
write(^S+UPSTRING(ud.filename));
spacelen(13-length(ud.filename));
if asciigraphics in urec.config then
write (^R'│'^S) else write(^R'|'^S);
desc:=ud.programname;
dah:=false;
if ud.newfile
then write (^P'['^S'New'^P'] ')
else if ud.specialfile
then write (^P'['^S'Ask'^P'] ')
else if ud.points>0
then tab (strr(ud.points),8)
else write (^P'['^S'Free'^P'] ');
if asciigraphics in urec.config then
write (^R'│') else write(^R'|');
if exist (getfname(ud.path,ud.filename)) then begin
write(^S,strlong(ud.filesize));
spacelen(11-length(strlong(ud.filesize)));
if asciigraphics in urec.config then
write (^R'│') else write(^R'|');
end;
if not exist (getfname(ud.path,ud.filename)) then begin
write (^P'['^S'Offline'^P']'^R' ');
if asciigraphics in urec.config then write(^R'│') else write(^R'|');
end;
{if length(ud.descrip)<=2 then begin
write (^P'['^S' No Description '^P']');
spacelen(19);
if asciigraphics in urec.config then
writeLn(^R'│') else writeln(^R'|');
end;
if length(ud.descrip)>38 then begin
repeat
up1:=37;
repeat
dec(up1);
lamedata:=copy(desc,up1,1);
if (lamedata=' ') and (dah=true) and (length(desc)>38) then begin
inc(cn);
if asciigraphics in urec.config then
write (^R'│ │ │ │ │') else
write (^R'| | | | |');
write(^S+copy(desc,1,up1));
spacelen(37-length(copy(desc,1,up1)));
if asciigraphics in urec.config then
writeln(^R'│') else writeln(^R'|');
delete(desc,1,up1);
end;
if (lamedata=' ') and (dah=false) then begin
inc(cn);
write(^s,copy(desc,1,up1));
spacelen(37-length(copy(desc,1,up1)));
if asciigraphics in urec.config then
writeln(^R,'│') else writeln(^R,'|');
delete(desc,1,up1);
dah:=true
end;
until (lamedata=' ')
until (length(desc)<=37);
end;
if length(ud.descrip)>38 then begin
if asciigraphics in urec.config then
write (^R'│ │ │ │ │') else
write (^R'| | | | |');
end;
if length(desc)>2 then begin
write(^S+desc);
spacelen(37-length(desc));
writeln(^R'│');}
write (^R' ');
write (^S+ud.programname);
spacelen(27-length(ud.programname));
if asciigraphics in urec.config then
write (^R'│ ') else write (^R'| ');
xy:=^S+strr(ud.disknum)+^R'/'^S+strr(ud.totaldisk);
tab (xy,10);
if asciigraphics in urec.config then
writeln(^R'│') else writeln(^R'|');
if cn>19{18} then cn:=19{18};
{end;}
end;
function nofiles:boolean;
begin
if numuds=0 then begin
nofiles:=true;
writestr (^M'Sorry, no files!')
end else nofiles:=false;
end;
Function capfir(inString:STRING):STRING;
begin
capfir:=upcase(inString[1]);
end;
procedure listfiles (extended:boolean);
var cnt,max,r1,r2:integer;
non:boolean;
begin
if nofiles then exit;
clearscr;
cn:=0;
non:=false;
max:=numuds;
thereare (max,'File','Files');
parserange (max,r1,r2);
if r1=0 then exit;
writeln;
topfileline;
for cnt:=r1 to r2 do begin
inc(cn);
if (cn>=19{18}) and (non=false) then
begin
bottomfileline;
cn:=0;
writestr(^P'File Listings Comamnds ['^S'Q/'^R'Quit'^P' - '^S'N/'^R'Non-stop'^P']'^S': '^U'*');
if capfir(input)='Q' then exit;
if capfir(input)='N' then non:=true;
topfileline;
end;
listfile (cnt,extended);
if break then exit
end;
bottomfileline;
end;